home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
data
/
happysrc
/
pcblock.c
< prev
next >
Wrap
Text File
|
1993-11-30
|
40KB
|
1,057 lines
/*********************************************************************
*
* *** HAPPy Pascal Compiler ***
* program,block コンパイル処理
*
* void programme(void)
* void block(Set fsys,enum symbol fsy,ctp *fprocp)
*
* Copyright (c) H.Asano 1992.
*
*********************************************************************/
#define EXTERN extern
#include <stdlib.h>
#include <string.h>
#include "pascomp.h"
#include "pcpcd.h"
void block(Set,enum symbol,ctp*) ;
static void body(Set,ctp*) ;
static void paramcopy(ctp*) ;
static void statement(Set) ;
static void compoundstatement(Set) ;
static void ifstatement(Set) ;
static void whilestatement(Set) ;
static void repeatstatement(Set) ;
static void forstatement(Set) ;
static void forident(attr*) ;
static void forexpres1(Set,attr);
static void forexpres2(Set,attr,enum symbol,int*,int*) ;
static void fordostatement(Set,attr,enum symbol,int) ;
static void assignment(Set,ctp*) ;
static void casestatement(Set) ;
static void withstatement(Set) ;
static void gotostatement(Set) ;
extern void call(Set,ctp*) ;
extern void expression(Set) ;
extern void selector(Set,ctp*) ;
extern ctp *mkctp(char*,enum idclass,stp*,ctp*) ;
extern void enterid(ctp*) ;
extern ctp *searchid(Set);
extern ctp *searchsection(ctp*) ;
extern void insymbol(void);
extern void skip(Set) ;
extern void updatelc(int) ;
extern void pcerr(int,char*) ;
extern char *inttoch(long) ;
extern char *inttoch(long) ;
extern char *inttoch(long) ;
extern Set *mkset(Set*,int,...) ;
extern Set *orset(Set*,Set*) ;
extern Set *dfset(Set*,Set*) ;
extern int crelabel(void) ;
extern void labeldecl(Set);
extern void constdecl(Set);
extern void typedecl(Set);
extern void vardecl(Set,ctp*);
extern void procfuncdecl(Set,enum symbol,ctp**);
extern void gencupent(enum pcdmnc, int, int) ;
extern void genjump(enum pcdmnc,int) ;
extern void putlabel(int) ;
extern void genret(stp*) ;
extern void putprogname(char*);
extern void putlblv(int,int) ;
extern void putq(void) ;
extern void gen0(enum pcdmnc) ;
extern void gen1(enum pcdmnc, int) ;
extern void gen0t(enum pcdmnc,stp*) ;
extern void gen1t(enum pcdmnc,stp*,int) ;
extern void gen2t(enum pcdmnc,stp*,int,int) ;
extern void genlca(void) ;
extern void genlda(int,int) ;
extern void genldc(char,long) ;
extern void genchk(stp*,int,long,long) ;
extern void convertint(stp*) ;
extern void load(void) ;
extern void loadaddress(void) ;
extern void store(attr) ;
extern void gencompare(enum pcdmnc,char,int) ;
extern void checkbounds(stp*,int) ;
extern boolean compatible(stp*,stp*) ;
extern boolean assigncompati(stp*,stp*) ;
extern int align(stp*,int) ;
extern void constant(Set,stp**,union valu*) ;
extern void *Malloc(int) ;
static int lcmax ;
/*******************************************************
* programme() : program の 処理
* 形式は、次の2通り
* program ident( filename,filename,・・・ ) ;
* program ident;
*******************************************************/
void programme(void)
{
extfilep *extfp ; /* ファイル名格納エリアのポインタ */
Set fsys ; /* block で 最初に現れるsymbolの集合*/
Set casesys; /* casesyだけの集合 (ワーク) */
ctp *cp ; /* input,output名前登録用 */
int i ;
int adr ;
boolean err196 ;
fextfilep = nil ;
if(sy == progsy) {
insymbol();
if(sy != ident) pcerr(2,""); /* 名前がない */
putprogname(id) ; /* プログラム名の出力 */
insymbol();
if((sy != lparent) && (sy != semicolon))
pcerr(14,""); /* ; がない */
if(sy == lparent) { /* プログラム引数の処理 */
do {
insymbol();
if(sy == ident) {
err196 = false ;
extfp = fextfilep ;
while(extfp) { /* 重複指定チェック */
if(!strcmp(extfp->filename,id)) {
pcerr(196,id) ; /* プログラム引数に同じ名前 */
err196 = true ;
}
extfp = extfp->nextfile ;
}
if(!err196) {
if(!(i=strcmp(id,"input")) || !(strcmp(id,"output"))) {
if(i!=0) { /* outputの時 */
adr = outputadr ;
defineoutput = true ; /* outputファイル定義済 */
}
else { /* inputの時 */
adr = inputadr ;
defineinput = true ; /* inputファイル定義済 */
}
cp = mkctp(id,vars,textptr,nil) ;
cp->n.v.vkind = actual ;
cp->n.v.vlev = level ;
cp->n.v.vaddr = adr ;
enterid(cp);
}
extfp = (extfilep*)Malloc(sizeof(extfilep)) ;
strcpy(extfp->filename,id);
extfp->nextfile = fextfilep ;
fextfilep = extfp ;
}
insymbol() ;
if((sy != comma) && (sy != rparent))
pcerr(20,"") ; /* , がない */
}
else pcerr(2,"") ; /* 名前がない */
} while(sy == comma);
if(sy != rparent) pcerr(14,""); /* ; がない */
insymbol();
}
if(sy!=semicolon) pcerr(14,""); /* ; がない */
else insymbol();
}
else pcerr(3,"") ; /* program がない */
fsys = blockbegsys ; /* fsys = blockbegsys */
orset(&fsys,&statbegsys) ; /* + statbegsys */
mkset(&casesys,casesy,-1) ;
dfset(&fsys,&casesys) ; /* - casesy */
do { /* 誤り回復のためrepeat */
block(fsys,period,nil) ; /* block の コンパイル */
if(sy != period) pcerr(21,"") ; /* *がない */
} while(sy != period) ;
}
/**************************************/
/* block() : block の 翻訳 */
/**************************************/
void block(Set fsys, /* blockに最初に現れるsymbolの集合 */
enum symbol fsy, /* blockの終わりのsymbol */
ctp *fprocp) /* proc/funcの名前ポインタ(mainはnil) */
{
enum symbol lsy ;
Set bodyfsys ;
ctp *pffwdptr = nil ; /* 手続き・関数の前方宣言リスト*/
ctp *lcp ;
extfilep *extp ; /* プログラム引数リスト */
do { /* declare partの処理 */
if(sy == labelsy) {
insymbol() ;
labeldecl(fsys) ; /* label節の処理 */
}
if(sy == constsy) {
insymbol() ;
constdecl(fsys) ; /* const節の処理 */
}
if(sy == typesy) {
insymbol() ;
typedecl(fsys) ; /* type節の処理 */
}
if(sy == varsy) {
insymbol() ;
vardecl(fsys,fprocp) ; /* var節の処理 */
} ;
if(fprocp == nil) { /* メインブロックの時 */
extp = fextfilep ;
while(extp) { /* プログラム引数の宣言チェック*/
strcpy(id,extp->filename) ;
lcp = searchsection(display[level].fname) ;
if(!lcp) pcerr(197,id) ; /* プログラム引数が未宣言 */
extp = extp->nextfile ;
}
gen1(iMST,0) ; /* mst命令の生成 */
mainlabel = crelabel() ; /* メインブロックのラベル名 */
gencupent(iCUP,0,mainlabel ) ; /* cup命令の生成 */
gen0(iSTP) ; /* stp命令の生成 */
}
while((sy == procsy) || (sy == funcsy)) {
lsy = sy ;
insymbol() ;
procfuncdecl(fsys,lsy,&pffwdptr) ;/* 手続き・関数の宣言処理 */
} ;
while(pffwdptr) { /* 手続き・関数の前方宣言チェック*/
pcerr(118,pffwdptr->name) ; /* 前方宣言の実体がない */
pffwdptr = pffwdptr->n.pf.sd.d.af.a.fwdptr ;
}
if(sy != beginsy) {
pcerr(18,"") ; /* 宣言部に誤りがある */
skip(fsys) ;
} ;
} while(! inset(statbegsys,sy)) ; /* 誤り回復のため繰り返し */
if(sy == beginsy) insymbol() ;
else pcerr(17,"") ; /* begin がない */
bodyfsys = fsys ;
addset(bodyfsys,casesy) ;
do {
body(bodyfsys,fprocp) ; /* begin ~ end の処理 */
if(sy != fsy) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(fsys) ;
}
} while((sy != fsy) && (! inset(blockbegsys,sy))) ;
}
/**************************************/
/* body() : body部 の 翻訳 */
/**************************************/
static void body(Set fsys,ctp *fprocp)
{
lbp *llp ;
int entname ;
Set statementfsys ;
int stacktop ;
int segsize ;
boolean test ;
topnew = topmax = lcaftermarkstack ;
entname = (!fprocp) ? mainlabel /* mainのbodyの時 */
: fprocp->n.pf.sd.d.af.a.pfname ; /* 手続き・関数のラベル値*/
putlabel(entname) ; /* ラベルの出力 */
segsize = crelabel() ;
stacktop= crelabel() ;
gencupent(iENT,1,segsize) ;
gencupent(iENT,2,stacktop) ;
if(fprocp) paramcopy(fprocp) ; /* 手続き・関数の時 仮引数を
スタックにコピーする */
lcmax = lc ;
/**** statement の 処理 ****/
statementfsys = fsys ; /* statementfsys = */
addset(statementfsys,semicolon); /* fsys + semicolon */
addset(statementfsys,endsy) ; /* + endsy */
do {
do {
statement(statementfsys);
} while(inset(statbegsys,sy)) ;
if(test=(sy == semicolon)) insymbol() ; /* ; ならば次のsymbolを読む */
} while(test) ; /* ; ならば繰り返す */
if(sy == endsy) insymbol() ;
else pcerr(13,"") ; /* end がない */
/**** ラベルの定義チェック ****/
llp = display[top].flabel;
while(llp) { /* 宣言られたラベルについて */
if(!llp->defined) /* 未定義 */
pcerr(168,inttoch((long)llp->labval)); /* ラベル未出現 */
llp = llp->nextlab ;
}
if(fprocp) { /* 手続き・関数内のブロックの時*/
genret(fprocp->idtype) ; /* 型に応じたret命令生成 */
if(fprocp->klass == func) /* 関数の時 */
if(!display[top].funcassign) /* 関数名への代入がない時 */
pcerr(176,fprocp->name) ; /* 関数名への代入がない */
}
else genret(nil) ; /* mainブロックの時はretp命令 */
putlblv(segsize , lcmax ) ;
putlblv(stacktop, topmax) ;
if(!fprocp) putq() ; /* mainブロックの時 q指令を出力*/
}
/**************************************/
/* paramcopy() : 値引数のコピー処理 */
/**************************************/
static void paramcopy(ctp *fprocp)
{
ctp *lcp ;
int llc ;
llc = lcaftermarkstack ;
lcp = fprocp->next ; /* 引数の先頭 */
while(lcp) {
llc = align(parmptr,llc) ; /* 境界調整 */
if(lcp->klass == vars) /* 変数の時 */
if(lcp->idtype)
if(lcp->idtype->form > power) { /* 配列・レコード型 */
if(lcp->n.v.vkind == actual) { /* 値引数 */
genlda(0,lcp->n.v.vaddr) ; /* lda命令 */
gen2t(iLOD,nilptr,0,llc) ; /* lod命令 */
gen2t(iMOV,nil,1,lcp->idtype->size); /* mov命令 */
}
llc += ptrsize ;
}
else llc += lcp->idtype->size ; /* スカラ、範囲、集合、ポインタ */
lcp = lcp->next ;
}
}
/**************************************/
/* statement() : 文 の コンパイル */
/**************************************/
static void statement(Set fsys)
{
Set ws ;
Set statfolsys ; /* 文の後に続くsymbolの集合 */
Set identsys ; /* 名前の集合 */
ctp *lcp ;
lbp *llp ;
mkset(&statfolsys, semicolon,endsy,elsesy,untilsy,-1);
mkset(&identsys, vars,field,func,proc,-1) ;
/**** label の 処理 ****/
if(sy == intconst) {
llp = display[level].flabel ;
while(llp) {
if(llp->labval == (int)val.ival) { /* 宣言されたラベルの時 */
if(llp->defined)
pcerr(165,inttoch(val.ival));/* ラベルが再度宣言された */
putlabel(llp->labname) ; /* ラベル値の出力 */
llp->defined = true ; /* 定義済 */
break ;
}
else llp = llp->nextlab ; /* ラベル名が違う時 */
}
if(!llp)
pcerr(167,inttoch(val.ival)); /* ラベルが未宣言 */
insymbol() ;
if(sy == colon) insymbol() ;
else pcerr(5,"") ; /* : がない */
}
/***********************/
if((! inset(fsys,sy)) && (sy != ident)) { /* 許されないsymbolの時 */
pcerr(6,"") ; /* 不当なsymbolが現れた */
skip(fsys) ;
}
if((inset(fsys,sy)) || (sy == ident)) { /* 文の最初としてOKの時 */
switch(sy) {
case ident : lcp=searchid(identsys) ;
insymbol() ;
if(lcp->klass != proc)
assignment(fsys,lcp) ; /* 代入文の処理 */
else if((lcp->klass == proc) &&
(inset(statfolsys,sy) || (sy == lparent)))
call(fsys,lcp) ; /* 手続きのみ呼出 */
else {
pcerr(6,"") ; /* 不当な記号が現れた */
ws = fsys ;
orset(&ws,&statfolsys) ;
skip(ws) ; /* 読み飛ばし */
}
break ;
case beginsy : insymbol() ;
compoundstatement(fsys) ;
break ;
case gotosy : insymbol() ;
gotostatement(fsys) ;
break ;
case ifsy : insymbol() ;
ifstatement(fsys) ;
break ;
case casesy : insymbol() ;
casestatement(fsys) ;
break ;
case whilesy : insymbol() ;
whilestatement(fsys) ;
break ;
case repeatsy : insymbol() ;
repeatstatement(fsys) ;
break ;
case forsy : insymbol() ;
forstatement(fsys) ;
break ;
case withsy : insymbol() ;
withstatement(fsys) ;
}
if(! inset(statfolsys,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(fsys) ;
}
}
}
/***************************************/
/* compoundstatement() : begin文の処理 */
/***************************************/
static void compoundstatement(Set fsys)
{
Set ws;
boolean test;
do {
do {
mkset(&ws,semicolon,endsy,-1);
orset(&ws,&fsys) ;
statement(ws) ;
} while(inset(statbegsys,sy)) ; /* statement以外がでてきた時終わり*/
if(test = (sy == semicolon)) insymbol() ; /* ; ならば次のsymbol */
} while(test) ; /* ; ならば繰り返す */
if(sy == endsy) insymbol() ; /* end ならば次のsymbol */
else pcerr(13,"") ; /* end がない */
}
/***************************************/
/* gotostatement() : goto文の処理 */
/***************************************/
static void gotostatement(Set fsys)
{
lbp *llp ;
int ttop,ttop1 ;
boolean found ;
if(sy == intconst) { /* ラベルは整数 */
found = false ;
ttop = top ;
while(display[ttop].occur != blck)
ttop-- ; /* block水準を探す */
ttop1 = ttop ;
do {
llp = display[ttop].flabel ;
while(llp) {
if(llp->labval == (int)val.ival) { /* ラベル値が同じ */
found = true ;
if(ttop == ttop1) /* ラベルの定義水準と同じ */
genjump(iUJP,llp->labname) ; /* ujp命令 */
else
gencupent(iEJP,level-ttop,llp->labname); /* ejp命令 */
break ; /* whileループを抜ける */
}
else llp = llp->nextlab ;
}
ttop-- ;
} while((! found) && (ttop != 0)) ;
if(! found)
pcerr(167,inttoch(val.ival)); /* ラベルが未宣言 */
insymbol() ;
}
else pcerr(164,"") ; /* ラベルが整数でない */
}
/***************************************/
/* ifstatement() : if文の処理 */
/***************************************/
static void ifstatement(Set fsys)
{
int lcix1,lcix2 ;
Set ws ;
ws = fsys ;
addset(ws,thensy) ;
expression(ws) ; /* ifの次の式を評価 */
load() ; /* 式の値をloadする */
if(gattr.typtr)
if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
pcerr(146,"if文") ; /* 演算対象は論理型でないと駄目*/
lcix1 = crelabel() ;
genjump(iFJP,lcix1) ; /* 偽ならelseまたはifの終わりに飛ぶ*/
if(sy == thensy) insymbol() ;
else pcerr(52,"") ; /* then がない */
ws = fsys ;
addset(ws,elsesy) ;
statement(ws) ; /* thenの次の文を処理 */
if(sy == elsesy) {
lcix2 = crelabel() ;
genjump(iUJP,lcix2) ; /* elseの終わりまで飛ぶ */
putlabel(lcix1) ; /* elseのラベル出力 */
insymbol() ;
statement(fsys) ; /* elseの次の文を処理 */
putlabel(lcix2) ; /* elseの終わりのラベル出力 */
}
else putlabel(lcix1) ; /* elseがない時 if文の終わりのラベル*/
}
/***************************************/
/* whilestatement() : while文の処理 */
/***************************************/
static void whilestatement(Set fsys)
{
int laddr ; /* 戻りラベル値 */
int lcix ; /* 飛び越しラベル値 */
Set ws ;
laddr = crelabel() ; /* ラベル値を得る */
putlabel(laddr) ; /* ラベル値の出力 */
ws = fsys ;
addset(ws,dosy) ;
expression(ws) ; /* whileの次の式の評価 */
load() ; /* 式の値をloadする */
if(gattr.typtr)
if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
pcerr(146,"while文") ; /* 演算対象は論理型でないと駄目*/
lcix = crelabel() ; /* 飛び越しラベル値を得る */
genjump(iFJP,lcix) ; /* fjp命令の生成 */
if(sy == dosy) insymbol() ;
else pcerr(54,"") ; /* do がない */
statement(fsys) ; /* 文の処理 */
genjump(iUJP,laddr); /* ujp命令でwhile文の先頭に戻る*/
putlabel(lcix) ; /* 飛び先ラベルの出力 */
}
/*****************************************/
/* repeatstatement() : repeat文の処理 */
/*****************************************/
static void repeatstatement(Set fsys)
{
int laddr ; /* 戻りラベル値 */
Set ws ;
boolean test ;
laddr = crelabel() ; /* ラベル値を得る */
putlabel(laddr) ; /* ラベル値の出力 */
mkset(&ws,semicolon,untilsy,-1);
orset(&ws, &fsys) ;
do {
do {
statement(ws) ; /* 文の処理 */
if(inset(statbegsys,sy))
pcerr(14,"") ; /* ; がない */
} while(inset(statbegsys,sy)); /* 文として正しいsymbolならリピート */
if(test = (sy==semicolon)) insymbol() ; /* ; ならば次のsymbol */
} while(test) ; /* ; ならば繰り返す */
if(sy == untilsy) {
insymbol() ;
expression(fsys) ; /* untilに続く式の評価 */
load() ; /* 式の値をloadする */
if(gattr.typtr)
if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
pcerr(146,"repeat文") ; /* 式は論理式でない */
genjump(iFJP,laddr) ; /* fjp命令の生成 */
}
else pcerr(53,"") ; /* until がない */
}
/***************************************/
/* forstatement() : for文のコンパイル */
/***************************************/
static void forstatement(Set fsys)
{
attr lattr ;
int llc ;
enum symbol lsy ;
int looplabel ; /* for文のループ用ラベル値 */
int forendlabel; /* for文終了の飛び先ラベル値 */
Set ws ;
llc = lc ; /* 変数割りつけ状況を退避 */
lattr.typtr = nil ; /* 制御変数の属性初期設定 */
lattr.kind = varbl ;
lattr.access = drct ;
lattr.vlevel = level ;
lattr.dplmt = 0 ;
if(sy == ident) forident(&lattr) ;
else {
pcerr(2,"") ; /* 名前がない */
mkset(&ws,becomes,tosy,downtosy,dosy,-1) ;
orset(&ws,&fsys) ;
skip(ws) ; /* 読み飛ばし */
}
if(sy == becomes) forexpres1(fsys,lattr) ; /* 式1の処理 */
else {
pcerr(51,"") ; /* := がない */
mkset(&ws,tosy,downtosy,dosy,-1) ;
orset(&ws,&fsys) ;
skip(ws) ; /* 読み飛ばし */
}
if((sy == tosy) || (sy == downtosy)) {
lsy = sy ; /* to か downsyを後で判断するため退避*/
forexpres2(fsys,lattr,lsy,&looplabel,&forendlabel) ; /* 式2の処理 */
}
else {
pcerr(55,"") ; /* to / downto がない */
mkset(&ws,dosy,-1) ;
orset(&ws,&fsys) ;
skip(ws) ; /* 読み飛ばし */
}
if(sy == dosy) insymbol() ;
else pcerr(54,"") ; /* do がない */
fordostatement(fsys,lattr,lsy,looplabel) ; /* doに続く文の処理*/
putlabel(forendlabel) ; /* for文の終わりラベル出力 */
lc = llc ; /* 一時変数を開放 */
}
/***************************************/
/* forident() : for文の制御変数処理 */
/***************************************/
static void forident(attr *fattr)
{
ctp *lcp ;
Set ws ;
int ltop ;
mkset(&ws,vars,-1) ;
lcp = searchid(ws) ; /* 変数の中から名前を探す */
(*fattr).typtr = lcp->idtype ; /* 変数の型 */
(*fattr).kind = varbl ;
if(lcp->n.v.vkind == actual) { /* 実変数ならばOK */
(*fattr).access = drct ;
(*fattr).vlevel = lcp->n.v.vlev ; /* 変数の宣言レベル */
(*fattr).dplmt = lcp->n.v.vaddr; /* 変数の割りつけアドレス */
ltop = top ;
while(display[ltop].occur != blck) /* block水準を探す */
ltop-- ;
if(lcp->n.v.vlev != ltop) /* 制御変数の定義水準が */
pcerr(186,id) ; /* for文と同一ぶろっくでない */
}
else {
pcerr(187,id) ; /* 変数引数を制御変数に使えない */
(*fattr).typtr = nil ;
}
if((*fattr).typtr)
if(((*fattr).typtr->form > subrange) || /* ポインタ型、集合型、 */
/* レコード型、ファイル型*/
(realptr == (*fattr).typtr)) { /* またはreal型 */
pcerr(188,id) ; /* 制御変数の型が不当 */
(*fattr).typtr = nil ;
}
insymbol() ;
}
/***************************************/
/* forexpres1() : for文の式1処理 */
/* for 制御変数:=式1 ・・・・ */
/***************************************/
static void forexpres1(Set fsys,attr fattr)
{
Set ws ;
insymbol() ;
mkset(&ws,tosy,downtosy,dosy,-1) ;
orset(&ws,&fsys) ;
expression(ws) ; /* 式1を評価 */
if(gattr.typtr)
if((gattr.typtr->form != scalar) || (gattr.typtr == realptr))
pcerr(144,"for文の初期値") ;/* 式が順序式でない */
else if(compatible(fattr.typtr,gattr.typtr)) { /* 制御変数と型が同じ*/
load() ; /* 式の値をload */
store(fattr) ; /* 制御変数域にstore */
}
else pcerr(145,"初期値") ; /* 制御変数と初期値の型が不適合*/
}
/****************************************/
/* forexpres2() : for文の式2処理 */
/* for ・・・ to/downto 式2 do ・・・ */
/****************************************/
static void forexpres2(Set fsys,attr fattr,
enum symbol fsy,int *flooplabel,int *forendlabel)
{
stp *lspfin ;
char typind ; /* gencompareに引き渡す型文字 */
int tempadr ; /* 一時変数域のアドレス */
Set ws ;
insymbol() ;
ws = fsys ;
addset(ws,dosy) ;
expression(ws) ; /* 式2を評価 */
lspfin = gattr.typtr ; /* 終値の属性を退避 */
if(lspfin == boolptr) typind = 'b' ; /* boolean */
else if(lspfin == charptr) typind = 'c' ; /* char */
else typind = 'i' ; /* integer/列挙型 */
if(lspfin)
if((lspfin->form != scalar) || (lspfin == realptr))
pcerr(144,"for文の終値") ; /* 順序式でない */
else if(compatible(fattr.typtr,lspfin)) { /* 制御変数と型が同じ*/
load() ; /* 式の値をload */
updatelc(align(lspfin,lc) - lc) ; /* 境界合わせ */
tempadr = lc ;
gen2t(iSTR,lspfin,0,tempadr) ; /* 一時変数域に式の値をstr*/
*flooplabel = crelabel() ;
if(!debug) /* debugでないならば */
putlabel(*flooplabel) ; /* ループラベル出力 */
gattr = fattr ;
load() ; /* 制御変数をload */
gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
updatelc(lspfin->size) ;
if(lc > lcmax) lcmax =lc ; /* 最大変数域サイズの更新 */
(fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならeq命令生成 */
: gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
}
else pcerr(145,"終値") ; /* 制御変数と終値の型が不適合 */
*forendlabel = crelabel() ; /* for文終了後の飛び先ラベル生成*/
genjump(iFJP,*forendlabel); /* fjp命令生成 */
if(debug) { /* debugの時 */
gattr = fattr ;
load() ; /* 制御変数をload */
checkbounds(fattr.typtr,52); /* 範囲チェック */
store(fattr) ;
gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
checkbounds(fattr.typtr,53) ; /* 範囲チェック */
gen2t(iSTR,lspfin,0,tempadr) ; /* 一時変数域に式の値をstr */
putlabel(*flooplabel) ; /* ループラベル出力 */
gattr = fattr ;
load() ; /* 制御変数をload */
gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
(fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならleq命令生成 */
: gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
genjump(iFJP,*forendlabel); /* fjp命令生成 */
}
}
/**********************************************/
/* fordostatement() : for文のdoに続く文の処理 */
/* for ・・・ do 文 */
/**********************************************/
static void fordostatement(Set fsys,attr fattr,
enum symbol fsy,int looplabel)
{
statement(fsys) ; /* 文の処理 */
gattr = fattr ;
load() ; /* 制御変数をload */
(fsy == tosy) ? gen1t(iINC,gattr.typtr,1) /* doなら inc 1 */
: gen1t(iDEC,gattr.typtr,1) ; /* downtoならdec 1 */
store(fattr) ;
genjump(iUJP,looplabel) ; /* ujp命令で戻る */
}
/*****************************************/
/* withstatement() : with文のコンパイル */
/*****************************************/
static void withstatement(Set fsys)
{
ctp *lcp ;
int oldlc ; /* lcの退避域 */
int oldtop ; /* display top の退避域 */
boolean test ;
Set ws ;
oldtop = top ; /* 今のdisplayのtopを退避 */
oldlc = lc ; /* 今のlcを退避 */
do {
if(sy == ident) {
mkset(&ws,vars,field,-1) ;
lcp = searchid(ws) ; /* 名前を変数、フィールド名より探す*/
insymbol() ;
}
else {
pcerr(2,"") ; /* 名前がない */
lcp = uvarptr ; /* 未定義用の変数ポインタ */
}
mkset(&ws,comma,dosy,-1) ;
orset(&ws,&fsys) ;
selector(ws,lcp) ; /* 変数の処理 */
if(gattr.typtr)
if(gattr.typtr->form == records)
if(top < Displimit) { /* displayがまだある時 */
top++ ;
display[top].fname = gattr.typtr->sf.re.fstfld ; /* 最初の欄*/
display[top].flabel = nil ; /* ラベル欄の初期設定 */
if(gattr.access == drct) { /* 直接参照の時 */
display[top].occur = crec ; /* 固定部のレコード欄 */
display[top].clev = gattr.vlevel ; /* 定義水準 */
display[top].cdspl = gattr.dplmt ; /* 相対アドレス */
}
else { /* 間接参照の時 */
loadaddress() ; /* loadaddress命令 */
updatelc(align(nilptr,lc)-lc);/* lcの境界調整 */
gen2t(iSTR,nilptr,0,lc) ; /* str命令 */
display[top].occur = vrec ; /* 可変レコード欄 */
display[top].vdspl = lc ; /* loadaddress 格納場所 */
updatelc(ptrsize) ; /* lcを1アドレス分進める */
if(lc > lcmax) lcmax = lc ;
}
}
else
pcerr(603,inttoch((long)Displimit));/* 名前の入れ子が深すぎる */
else pcerr(140,"") ; /* 変数の型がレコードでない */
if(test = (sy == comma)) insymbol() ; /* , なら次の変数を読む */
} while(test) ; /* , なら次の変数の処理へ */
if(sy == dosy) insymbol() ;
else pcerr(54,"") ; /* do がない */
statement(fsys) ; /* with文配下の文の処理 */
top = oldtop ; /* 水準を元に戻す */
lc = oldlc ; /* lcを元に戻す */
}
/**************************************/
/* assignment() : 代入文のコンパイル */
/**************************************/
static void assignment(Set fsys,ctp *fcp)
{
attr lattr ; /* 1つ前の属性 */
Set ws ;
ws = fsys ;
addset(ws,becomes) ;
selector(ws, fcp) ; /* 左辺の処理 */
if(fcp->klass == func) /* 左辺が関数の時 */
if(fcp->n.pf.pfdeckind == standard) {
pcerr(150,fcp->name) ; /* 標準関数への代入は駄目 */
gattr.typtr = nil ;
}
else if(fcp->n.pf.sd.d.pfkind == formal)
pcerr(151,"") ; /* 関数引数への代入は駄目 */
else if(display[fcp->n.pf.sd.d.pflev+1].funcname != fcp)
pcerr(177,fcp->name) ; /* ここでは代入できない */
else display[fcp->n.pf.sd.d.pflev+1].funcassign = true ;
/* 関数名への代入あり */
if(sy == becomes) {
if(gattr.typtr)
if((gattr.access != drct) || /* 直接参照でないか */
(gattr.typtr->form > power)) /* 配列型、レコード型、ファイル型*/
loadaddress() ; /* の時は、アドレスをのせる */
lattr = gattr ; /* 今の属性を退避しておく */
insymbol() ;
expression(fsys) ; /* 右辺の処理 */
if(gattr.typtr)
if(gattr.typtr->form <= power) /* スカラー、範囲、ポインタ、集合*/
load() ;
else loadaddress() ;
if((lattr.typtr) && (gattr.typtr)) {
if((lattr.typtr == realptr) && /* 左辺が実数型で */
(compatible(gattr.typtr,intptr))) { /* 右辺が整数型の時 */
gen0(iFLT) ; /* 実数に変換 flt命令 */
gattr.typtr = realptr ;
}
if(assigncompati(lattr.typtr,gattr.typtr)) /* 代入可能な時 */
switch(lattr.typtr->form) { /* 型によって振り分ける */
case scalar :
case subrange :
checkbounds(lattr.typtr,49) ; /* 上限・下限のチェック */
store(lattr) ;
break ;
case pointer :
store(lattr) ;
break ;
case power :
checkbounds(lattr.typtr,50) ; /* 上限・下限のチェック */
store(lattr) ;
break ;
case arrays :
case records :
gen2t(iMOV,nil,1,lattr.typtr->size) ;
}
else pcerr(129,"") ; /* 代入可能でない */
}
}
else pcerr(51,"") ; /* := がない */
}
/*****************************************/
/* casestatement() : case文のコンパイル */
/*****************************************/
typedef struct caseinfo cip ;
struct caseinfo {
cip *next ;
int csstart ; /* P-codeラベル値 */
long cslab ; /* 定数値 */
} ;
static void casestatement(Set fsys)
{
stp *lsp,*lsp1 ;
cip *lpt,*lpt1,*lpt2,*lpt3,*fstptr;
int laddr ;
int lcix,lcix1;
long lmin,lmax;
union valu lval ;
boolean test ;
Set ws ;
mkset(&ws,ofsy,comma,colon,-1) ;
expression(ws) ; /* caseに続く式の処理 */
load() ; /* 式の値をload */
lsp = gattr.typtr ;
if(lsp)
if((lsp->form != scalar) || (lsp == realptr)) {
pcerr(144,"case文の選択式") ; /* 順序式でない */
lsp = nil ;
}
else
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
lcix = crelabel() ;
genjump(iUJP,lcix) ; /* 式の値チェックへ飛ぶ */
if(sy == ofsy) insymbol() ;
else pcerr(8,"") ; /* of がない */
fstptr = nil ;
laddr = crelabel() ;
do {
lpt = nil ;
lcix1 = crelabel() ;
mkset(&ws,endsy,semicolon,-1);
if(! inset(ws,sy)) { /* ; end でなければ */
do {
mkset(&ws,comma,colon,-1);
orset(&ws,&fsys) ;
constant(ws,&lsp1,&lval) ; /* 定数の処理 */
if(lsp1)
if(lsp == lsp1) { /* 式の型と定数の型を比較 */
lpt1 = fstptr ;
lpt2 = nil ;
while(lpt1) {
if(lpt1->cslab <= lval.ival) {
if(lpt1->cslab == lval.ival)/* 前の定数と同じ値の時 */
pcerr(156,"") ; /* case文の名札が再度定義された*/
break ;
}
lpt2 = lpt1;
lpt1 = lpt1->next ;
}
lpt = (cip*)Malloc(sizeof(cip)) ;
lpt->next = lpt1;
lpt->cslab = lval.ival ;
lpt->csstart = lcix1;
if(!lpt2) fstptr = lpt;
else lpt2->next = lpt;
}
else pcerr(147,"") ; /* case文の名札の型がおかしい */
if(test=(sy==comma)) insymbol() ; /* , ならば次の定数を読む */
} while(test) ; /* , ならば次の定数の処理 */
if(sy == colon) insymbol() ;
else pcerr(5,"") ; /* : がない */
putlabel(lcix1) ;
ws = fsys;
addset(ws,semicolon) ;
lpt3 = lpt; /* QuickCのバグのため(lpt破壊)*/
do { /* 誤り回復のため繰り返し */
statement(ws) ; /* 定数に対する文の処理 */
} while(inset(statbegsys,sy));
if(lpt3) genjump(iUJP,laddr);
}
if(test=(sy==semicolon)) insymbol() ;/* ; ならば次の定数を読む */
} while(test) ; /* ; ならば次の定数の処理 */
putlabel(lcix) ;
if(fstptr) { /* reverse pointer */
lmax = fstptr->cslab ;
lpt1 = fstptr ;
fstptr = nil ;
do {
lpt2 = lpt1->next ;
lpt1->next = fstptr;
fstptr = lpt1;
lpt1 = lpt2 ;
} while(lpt1) ;
lmin = fstptr->cslab;
if(lmax - lmin < Cixmax) {
genchk(intptr,51,lmin,lmax);
genldc('i',lmin);
gen0(iSBI) ;
lcix = crelabel() ;
genjump(iXJP,lcix) ;
putlabel(lcix);
do {
while(fstptr->cslab > lmin) {
gen0(iUJC) ;
lmin++ ;
}
genjump(iUJP,fstptr->csstart);
fstptr = fstptr->next ;
lmin++ ;
} while(fstptr) ;
putlabel(laddr) ;
}
else
pcerr(601,inttoch((long)Cixmax)) ; /* case文の選択の範囲が大きすぎる*/
}
if(sy == endsy) insymbol() ;
else pcerr(13,"") ; /* end がない */
}